home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-bat.el.z / ilisp-bat.el
Encoding:
Text File  |  1998-05-21  |  4.4 KB  |  138 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-bat.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23. ;;;
  24. ;;; Inferior LISP interaction package batch submodule.
  25.  
  26. ;;; See ilisp.el for more information.
  27. (defun mark-change-lisp (arg)
  28.   "Mark the current defun as being changed so that lisp-eval-changes,
  29. or lisp-compile-changes will work on it.  With a prefix, unmark."
  30.   (interactive "P")
  31.   (let (point name)
  32.     (save-excursion
  33.       (setq point (lisp-defun-begin)
  34.         name (lisp-def-name)))
  35.     (if arg
  36.     (let ((marker (car (lisp-memk point lisp-changes 'marker-position))))
  37.       (message "%s marked as unchanged" name)
  38.       (setq lisp-changes (delq marker lisp-changes)))
  39.     (message "%s marked as changed" name)
  40.     (if (not (lisp-memk point lisp-changes 'marker-position))
  41.         (let ((new (make-marker)))
  42.           (set-marker new point)
  43.           (setq lisp-changes (cons new lisp-changes)))))))
  44.  
  45. ;;;
  46. (defun list-changes-lisp ()
  47.   "List the name of LISP forms currently marked as being changed."
  48.   (interactive)
  49.   (let ((names (reverse (mapcar (function
  50.                  (lambda (change)
  51.                   (save-excursion
  52.                     (set-buffer (marker-buffer change))
  53.                     (goto-char change)
  54.                     (lisp-def-name))))
  55.                 lisp-changes))))
  56.     (if names
  57.     (with-output-to-temp-buffer "*Changed-Definitions*"
  58.       (display-completion-list names)
  59.       (save-excursion
  60.         (set-buffer "*Changed-Definitions*")
  61.         (goto-char (point-min))
  62.         (kill-line)
  63.         (insert "Changed LISP forms:")))
  64.     (error "No changed definitions"))))
  65.  
  66. ;;;
  67. (defun clear-changes-lisp ()
  68.   "Clear the list of LISP forms currently marked as being changed."
  69.   (interactive)
  70.   (message "Cleared changes")
  71.   (setq lisp-changes nil))
  72.  
  73. ;;;
  74. (defun lisp-change-handler (&rest args)
  75.   "Handle an error during a batch process by keeping the change on the
  76. list and passing it on to the normal error handler." 
  77.   (let ((change (car ilisp-pending-changes)))
  78.     (if (and comint-errorp
  79.          (not (lisp-memk change lisp-changes 'marker-position)))
  80.     (setq lisp-changes (nconc lisp-changes (cons change nil)))))
  81.   (setq ilisp-pending-changes (cdr ilisp-pending-changes))
  82.   (apply comint-handler args))
  83.  
  84. ;;;
  85. (defun lisp-changes (command message)
  86.   "Apply COMMAND to each of the changes and use MESSAGE to print a
  87. message given the name of the change.  If there is a positive prefix,
  88. the change list will not be changed."
  89.   (save-excursion
  90.     (set-buffer (ilisp-buffer))
  91.     (let ((keep (and current-prefix-arg (not (eq current-prefix-arg '-))))
  92.       (changes (reverse lisp-changes))
  93.       (lisp-wait-p nil))
  94.       (setq ilisp-pending-changes (nconc ilisp-pending-changes changes)
  95.         current-prefix-arg nil)    ;Prevent buffer insertion
  96.       (if comint-queue-emptied 
  97.       (save-excursion
  98.         (setq comint-queue-emptied nil)
  99.         (set-buffer (get-buffer-create "*Errors*"))
  100.         (delete-region (point-min) (point-max))))
  101.       (while changes
  102.     (let* ((change (car changes))
  103.            name)
  104.       (set-buffer (marker-buffer change))
  105.       (goto-char change)
  106.       (setq name (lisp-def-name))
  107.       (forward-sexp)
  108.       (funcall command change (point) nil (format message name)
  109.            nil 'lisp-change-handler)
  110.       (setq changes (cdr changes))))
  111.       (comint-send-code
  112.        (ilisp-process)
  113.        (function (lambda ()
  114.      (save-excursion
  115.        (set-buffer (get-buffer-create "*Last-Changes*"))
  116.        (delete-region (point-min) (point-max))
  117.        (insert (save-excursion
  118.              (set-buffer "*Errors*")
  119.              (buffer-string)))))))
  120.       (if keep
  121.       (message "Started, but keeping changes")
  122.       (message "Started changes")
  123.       (setq lisp-changes nil)))))
  124.  
  125. ;;;
  126. (defun eval-changes-lisp ()
  127.   "Evaluate the forms marked as being changed.  With prefix, do not
  128. clear the change list."
  129.   (interactive)
  130.   (lisp-changes 'eval-region-lisp "Evaluate changed %s"))
  131.  
  132. ;;;
  133. (defun compile-changes-lisp ()
  134.   "Compile the forms marked as being changed.  With prefix, do not
  135. clear the change list."
  136.   (interactive)
  137.   (lisp-changes 'compile-region-lisp "Compile changed %s"))
  138.